home *** CD-ROM | disk | FTP | other *** search
/ Software Vault: The Gold Collection / Software Vault - The Gold Collection (American Databankers) (1993).ISO / cdr27 / smpsqzpr.zip / SMPSQZGW.BAS < prev    next >
BASIC Source File  |  1993-05-26  |  3KB  |  82 lines
  1. 10 CLEAR
  2. 15 WIDTH LPRINT 254
  3. 20 OPTION BASE 1:DEFINT A-Z:DIM BUFFER$(2,66),FLY$(10),BUFF,BUFFLINE,COUNT,FLAG,FLAG2,FLY,FLYNO,MAX,A$,B$,ESC$,F$,Z$
  4. 30 GOSUB 1000:'blurb
  5. 40 GOSUB 2000:'initialize buffer,get get file name
  6. 45 FOR FLY=1 TO FLYNO
  7. 46 F$=FLY$(FLY)
  8. 47 BUFF=1:BUFFLINE=1:BLOCK=1:FLAG=0:FLAG2=0:LPRINT Z$;
  9. 48 ON ERROR GOTO 60000:OPEN"i",1,F$
  10. 49 CLS:PRINT TAB(20)"PRINTING FILE: "F$
  11. 50 IF EOF(1) THEN GOSUB 5000:GOTO 220
  12. 55 IF FLAG=1 THEN 70
  13. 60 GOSUB 3000:'line input routine
  14. 70 IF A$="" THEN 50
  15. 80 IF A$=STRING$(LEN(A$),32) THEN 50
  16. 90 IF LEN(A$)>80 THEN FLAG=1 ELSE FLAG=0
  17. 100 LSET BUFFER$(BUFF,BUFFLINE)=A$
  18. 105 IF FLAG=1 THEN A$=MID$(A$,81)
  19. 110 BUFFLINE=BUFFLINE +1
  20. 120 IF BUFFLINE <67 THEN 50
  21. 130 IF BUFF=1 THEN BUFF=2:BUFFLINE=1:GOTO 50
  22. 139 ' REST FOLLOWS FROM FILLING BUFFER 2
  23. 140 BUFFLINE=1
  24. 150 MAX=66:GOSUB 4000:' PRINT THE BLOCK
  25. 195 BUFF=1
  26. 200 IF BLOCK=1 THEN LPRINT STRING$(159,"#"):BLOCK=2:GOTO 50
  27. 210 LPRINT STRING$(159,"#");CHR$(12);:BLOCK=1:GOTO 50
  28. 220 NEXT FLY
  29. 230 END
  30. 1000 CLS
  31. 1010 PRINT TAB(20)"SIMPLE SQUEEZE PRINT":PRINT
  32. 1020 PRINT:PRINT: PRINT TAB(20)"(c) C.R.J.Currie 1990"
  33. 1100 RETURN
  34. 2000 PRINT: PRINT "initializing buffer"
  35. 2010 FOR COUNT=1 TO 66:FOR N=1 TO 2
  36. 2020 BUFFER$(N,COUNT)=STRING$(80,32)
  37. 2030 NEXT:NEXT
  38. 2035 ESC$=CHR$(27)
  39. 2036 Z$=ESC$+"@"+ESC$+CHR$(15)+ESC$+"M"+ESC$+"Q"+CHR$(160)+ESC$+"S0"+ESC$+"A"+CHR$(5)
  40. 2038 :INPUT"HOW MANY FILES TO PRINT (MAX. 10)";FLYNO
  41. 2039 IF FLYNO<1 OR FLYNO>10 THEN PRINT"TOO FEW OR TOO MANY!":PRINT:GOTO 2038
  42. 2040 FOR FLY=1 TO FLYNO
  43. 2047 PRINT"ENTER NAME OF FILE NO.";FLY;":";:LINE INPUT F$:FLY$(FLY)=F$
  44. 2049 NEXT FLY
  45. 2050 PRINT :LINE INPUT"GET PRINTER READY AND PRESS ENTER TO CONTINUE: ";DUMMY$
  46. 2070 RETURN
  47. 3000 LINE INPUT#1,A$:RETURN:' OK for model 4 etc
  48. 3009 REM for model III bascom: return line in A$
  49. 3010 A$=""
  50. 3015 IF EOF(1) THEN CLOSE:GOTO 3500
  51. 3020 B$=INPUT$(1,#1)
  52. 3030 IF B$=CHR$(13) THEN 3500 ELSE A$=A$+B$:GOTO 3015
  53. 3500 RETURN
  54. 3999 REM PRINT ROUTINE
  55. 4000 FOR COUNT=1 TO MAX
  56. 4010 SPEW$=BUFFER$(1,COUNT)+BUFFER$(2,COUNT)
  57. 4020 LPRINT SPEW$
  58. 4030 NEXT
  59. 4040 RETURN
  60. 4999 'TIDY UP ROUTINE
  61. 5000 CLOSE
  62. 5010 IF BUFF=2 THEN GOSUB 6000:MAX=66:GOSUB 4000:LPRINT STRING$(159,"#");CHR$(12);:GOTO 5800
  63. 5011 BUFFLINE=BUFFLINE-1
  64. 5015 IF BUFFLINE<>(INT(BUFFLINE/2)*2) THEN FLAG2=1 ELSE FLAG2=0
  65. 5020 MAX=INT(BUFFLINE/2)+1
  66. 5030 IF MAX>33 THEN MAX=33
  67. 5040 FOR COUNT=1 TO MAX
  68. 5050 LSET BUFFER$(2,COUNT)=BUFFER$(1,MAX+COUNT)
  69. 5055 NEXT
  70. 5060 IF FLAG2=1 THEN LSET BUFFER$(2,COUNT)=" "
  71. 5070 GOSUB 4000
  72. 5080 LPRINT STRING$(159,"#");CHR$(12);
  73. 5800 RETURN
  74. 5999 'BLANK OUT REST OF BUFF2
  75. 6000 START=BUFFLINE+1
  76. 6010 FOR COUNT=START TO 66
  77. 6020 LSET BUFFER$(2,COUNT)=" "
  78. 6025 NEXT COUNT
  79. 6030 RETURN
  80. 60000 IF ERL=48 THEN PRINT "Cannot open file: ";F$:CLOSE:STOP
  81. 60010 PRINT"unexpected error no. ";ERR;" in line: ";ERL:STOP
  82.